;;; Boosh does not support the arithmetic operators natively Here we
;;; have defined +, -, *, and / in terms of the native operators.
;;; Numbers are represented as lists of digits, with the least
;;; significant digit listed first for convenience:
;;; 4972 -> (quote (2 7 9 4))
;;; Negative numbers have a dash as their first atom:
;;; -32 -> (quote (- 2 3))

;;; Returns true if the argument is the empty list
(define null (lambda (x)
	       (eq x '())))

;;; Merges two lists
;;; (append '(1 2) '(3 4)) -> (1 2 3 4)
(define append (lambda (x y) 
		 (cond ((null x) y)
		       ('#t (cons (car x)
				  (append (cdr x) y))))))

(define or (lambda (x y)
 	     (cond (x '#t)
 		   (y '#t)
 		   ('#t '()))))

(define not (lambda (x)
 	      (cond (x '())
 		    ('#t '#t))))

;;; Returns true if and only if both arguments are true
(define and (lambda (x y)
	      (cond (x (cond (y '#t)
			     ('#t '())))
		    ('#t '()))))

(define cdar (lambda (x)
	       (cdr (car x))))

(define cadr (lambda (x)
 	       (car (cdr x))))

(define caar (lambda (x)
 	       (car (car x))))

(define caddr (lambda (x)
		(car (cdr (cdr x)))))

(define cadar (lambda (x)
		(car (cdr (car x)))))

(define caddar (lambda (x)
		 (car (cdr (cdr (car x))))))

(define pair (lambda (x y)
 	       (cond ((and (null x) (null y)) '())
 		     ((and (not (atom x)) (not (atom y)))
 		      (cons (cons (car x) (cons (car y) '()))
 			    (pair (cdr x) (cdr y)))))))

(define assoc (lambda (x y)
 		(cond ((eq (caar y) x) (cadar y))
 		      ('#t (assoc x (cdr y))))))

;;; True if x is longer than y
(define longer (lambda (x y)
 		 (cond ((null x) '())
		       ((null y) '#t)
 		       ('#t (longer (cdr x) 
				    (cdr y))))))

;;; assumes both lists contain only atoms
;;; true if both lists are of the same length and contain the same atoms
(define list-atom-equal (lambda (x y)
		     ((lambda (nullx nully)
			(cond ((and nullx nully) '#t)
			      ((or nullx nully) '())
			      ((eq (car x) (car y)) (list-atom-equal (cdr x) (cdr y)))
			      ('#t '())))
		      (null x) (null y))))

;;; Returns the reversed list
(define reverse (lambda (x)
		  (cond ((eq x '()) '())
			('#t (append (reverse (cdr x)) 
					    (cons (car x) '()))))))

;;; Returns the last element in a list
;;; (last '(1 2 (3 4)) -> (3 4)
(define last (lambda (x)
	       (cond ((eq (cdr x) '())
		      (car x))
		     ('#t
		      (last (cdr x))))))

;;; The only actual meaning of numbers in the language
;;; Ordering of digits
(define *digits (lambda () '(0 1 2 3 4 5 6 7 8 9)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Equality ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define dig> (lambda (x y digits)
	       (cond ((eq x y) '())
		     ((eq x (car digits)) '())
		     ((eq y (car digits)) '#t)
		     ('#t (dig> x y (cdr digits))))))

;;; x and y are reversed numbers (highest order decimal bit in the front)
;;; assumes x an y have the same number of digits
(define helper> (lambda (x y)
		  (cond ((null x) '())
			((eq (car x) (car y))
			 (helper> (cdr x) (cdr y)))
			((dig> (car x) (car y) (*digits)) '#t)
			('#t '()))))

;;; Works for nonnegative integers only
(define > (lambda (x y)
 	    (cond ((and (eq (car x) '-) (eq (car y) '1))
 		   (> (cdr y) (cdr x)))
 		  ((eq (car x) '-) '())
 		  ((eq (car y) '-) '#t)
 		  ('#t (cond ((longer x y) '#t)
			     ((longer y x) '())
			     ('#t (helper> (reverse x) 
					   (reverse y))))))))

(define = (lambda (x y)
 	    (list-atom-equal x y)))


(define >= (lambda (x y)
 	     (or (= x y) (> x y))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Addition ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Returns of list of length x
;;; (digit-to-list 3) -> (. . .)
(define digit-to-list (lambda (x digits)
			(cond ((eq (car digits) x) '())
			      ('#t (cons '. (digit-to-list x (cdr digits)))))))

;;; Takes a list of length n and an ordering of digits
;;; Retuns the digit n, with an appended 1 if there is a carry
;;; (list-to-digit '(...(14 elements)...) digit-ordering) -> (1 4)
(define list-to-digit (lambda (x temp-digits)
 			(cond ((null temp-digits) 
 			       (cons '1 (list-to-digit x (*digits))))
 			      ((null x) 
			       (cons (car temp-digits) '()))
 			      ('#t (list-to-digit (cdr x) 
						  (cdr temp-digits))))))

;;; Takes two digits and a carry (either 0 or 1)
;;; Returns the sum of the two digits
;;; (digit-add '5 '9 '0) -> (1 4)
(define digit-add (lambda (x y carry)
 		    (list-to-digit (append (cond ((eq carry '1) '(.))
 						 ('#t '()))
 					   (append (digit-to-list x (*digits)) 
 						   (digit-to-list y (*digits))))
 				   (*digits))))		     


;;; Recursively adds the digits of two numbers to get the sum		
(define helper+ (lambda (x y carry)
 		  (cond ((and (null x) (null y)) 
 			 (cond ((eq carry '0) '())
 			       ('#t '(1))))
 			((null x) (helper+ '(0) y carry))
 			((null y) (helper+ x '(0) carry))
 			('#t ((lambda (res)
				(cond ((eq (cdr res) '()) (cons (car res)
								(helper+ (cdr x) (cdr y) '0)))
				      ('#t (cons (cadr res)
						 (helper+ (cdr x) (cdr y) '1)))))
			      (digit-add (car x) (car y) carry))))))




(define same-sign+ (lambda (x y pos)
 		     (cond (pos (helper+ x y '0))
			   ('#t (cons '- 
				      (helper+ (cdr x) (cdr y) '0))))))


;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Subtraction ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;Subtracts two lists, and appends a dummy value if there is a carry
;;Subtracting 4 from 1 would result in a list of 8 elements 
;;(1 dummy value for the carry and 7 atoms for the answer)
;;(list-subtract '(.) '(. . . .)) -> ((.) . . . . . . .)
(define list-subtract (lambda (x y carry)
 			(cond ((null y) 
			       (cond ((eq carry '0) x)
				     ('#t (cond ((null x) 
						 (cons '(.) 
						       (digit-to-list (last (*digits))
								      (*digits))))
						('#t (cdr x))))))
 			      ((null x) (cons '(.)
 					      (list-subtract (cons '. 
								   (digit-to-list (last (*digits))
										  (*digits)))
							     y carry)))
 			      ('#t (list-subtract (cdr x) 
						  (cdr y) 
						  carry)))))

;; ;;; Takes two digits and a carry (either 0 or 1)
;; ;;; Returns the difference of the two digits, modulo 10 if necessary (with a carry element)
;; ;;; (digit-subtract '5 '9 '1) -> (1 5)
(define digit-subtract (lambda (x y carry)
 			 ((lambda (res)
 			    (cond ((cond ((not (null res)) 
 					  (cond ((not (atom (car res))) '#t)
 						('#t '())))
 					 ('#t '()))
 				   (cons '1 (list-to-digit (cdr res) (*digits))))
 				  ('#t (list-to-digit res (*digits)))))
 			  (list-subtract (digit-to-list x (*digits))
 					 (digit-to-list y (*digits))
 					 carry))))


;;; Recursively subtracts the digits of two numbers to get the sum
;;; x must be >= y
(define helper- (lambda (x y carry)
 		  (cond ((and (null x) (null y)) '())
 			((null y) (cond ((eq carry '0) x)
 					('#t (cond ((= x '(1)) '())
						   ('#t (helper- x '(0) '1))))))
 			('#t ((lambda (res)
				(cond ((eq (cdr res) '())
					      ((lambda (res2)
						 (cond ((and (eq (car res) '0)
							     (null res2))
							'())
						       ('#t (cons (car res) res2))))
					       (helper- (cdr x) (cdr y) '0)))
					     ('#t ((lambda (res2)
						     (cond ((and (eq (cadr res) '0)
									(null res2)) '())
								  ('#t (cons (cadr res) res2))))
							  (helper- (cdr x) (cdr y) '1)))))
				     (digit-subtract (car x) (car y) carry))))))


(define - (lambda (x y)
  	    ((lambda (negx negy)
 	       (cond ((and negx negy)
 		      (- (cdr y) (cdr x)))
		     (negx (cons '- (same-sign+ (cdr x) y '#t)))
		     (negy (same-sign+ x (cdr y) '#t))
		     ('#t (cond ((> y x) (append (cons '- '())
						 ((lambda (res)
						    (cond ((null res) '(0))
							  ('#t res)))
						  (helper- y x '0))))
				       ('#t ((lambda (res)
						      (cond ((null res) '(0))
							    ('#t res)))
					     (helper- x y '0)))))))
	     (> '(0) x) (> '(0) y))))



;;; Addition
(define + (lambda (x y)
 	    ((lambda (negx negy)
 	       (cond ((and negx negy)
 		      (cons '- (+ (cdr x) (cdr y))))
 		     (negx (- y (cdr x)))
 		     (negy (- x (cdr y)))
 		     ('#t (helper+ x y '0))))
 	     (> '(0) x) (> '(0) y))))


;;; Returns the length of a list
(define length (lambda (x)
		 (cond ((null x) '(0))
		       ('#t (+ '(1) (length (cdr x)))))))

;;; Returns the first len elements of the list x
(define sublist (lambda (x len)
		  (cond ((= len '(0)) '())
			('#t (cons (car x) 
				   (sublist (cdr x) 
					    (- len '(1))))))))

;;; creates a list of length len full of atoms a
(define create-list (lambda (a len)
		      (cond ((= len '(0)) '())
			    ('#t (cons a (create-list a (- len '(1))))))))


;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Multiplication ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;                             


(define dig-dig* (lambda (x y)
		   ((lambda (xnum ynum)
		      (cond ((= ynum '(0)) '(0))
			    ('#t (+ xnum (dig-dig* (car xnum) 
						   (car (- ynum '(1))))))))
		    (cons x '()) (cons y '()))))


(define dig-long* (lambda (x y)
 		    (cond ((null y) '(0))
 			  ('#t (+ (dig-dig* x (car y))
				  ((lambda (res)
				     (cond ((= res '(0)) res)
					   ('#t (cons '0 res))))
				   (dig-long* x (cdr y))))))))

(define helper* (lambda (x y)
 		  (cond ((null y) '(0))
 			('#t (+ (dig-long* (car y) x)
				       (cons '0 ((lambda (res)
						   (cond ((= res '(0)) '())
								('#t res)))
							(helper* x (cdr y)))))))))


;;; multiplication
(define * (lambda (x y)
 	    ((lambda (negx negy)
 	       (cond ((and negx negy) (helper* (cdr x) (cdr y)))
 		     (negx (cons '- (helper* (cdr x) y)))
 		     (negy (cons '- (helper* x (cdr y))))
 		     ('#t (helper* x y))))
 	     (> '(0) x) (> '(0) y))))


;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Division ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; x into y
;;; returns y divided by x by means of repeated subtraction
(define div-by-mult (lambda (x y)
		      (cond ((> x y) '(0))
			    ('#t (+ '(1) (div-by-mult x (- y x)))))))

;;; x into y
;;; returns the first digit to write down when dividing y by x
;;; (first-div-val 789 2) -> 3
(define first-div-val (lambda (x y)
			(div-by-mult x
				     (reverse (sublist (reverse y)
						       (+ (cond ((> x (reverse (sublist (reverse y) 
											(length x)))) '(1))
								('#t '(0)))
							  (length x)))))))


(define rln-helper (lambda (x)
		     (cond ((null x) '(0))
			   ((eq (car x) '0) (rln-helper (cdr x)))
			   ('#t x))))

;;; removes zeros from the end of a number list
(define reduce-list-number (lambda (x)
			     (rln-helper (reverse x))))

;;; updates a divisor given the value that was just computed
;;; (update-divisor 123 12) -> (3 1)
;;; second value of the result is the min number of extra digits the quotient must have
(define update-divisor (lambda (x y sublen)
			 (cond ((>= (reverse (sublist (reverse x) sublen)) y)
				((lambda (newsub)
				   (cons (reverse (reduce-list-number
					  ((lambda (res)
					     (cond ((null res) '(0))
						   ('#t res)))
					   (append (sublist x (- (length x) sublen))
						   (cond ((= newsub '(0)) '())
							 ('#t newsub))))))
					 (cons (- (length x) (length y))
					       '())))
				 (- (reverse (sublist (reverse x) sublen)) y)))
			       ('#t (update-divisor x y (+ sublen '(1)))))))


;;; adds len zeros to the end of lis
(define pad-zero (lambda (lis len)
		   (cond ((> len (length lis))
			  (append lis (create-list '0 (- len (length lis)))))
			 ('#t lis))))

;;; helper division function
;;; quotient must have at least minlen zeroes
(define helper/ (lambda (x y minlen)
		  (cond ((> y x) (pad-zero '() minlen))
			('#t ((lambda (res) 
				((lambda (res2)
				   (pad-zero (append (helper/ (car res2) y (cadr res2))
						     (cons (car res) '()))
					     minlen))
				 (update-divisor x (* res y) '(1))))
			      (first-div-val y x))))))


;;;division
(define / (lambda (x y)
	    ((lambda (negx negy)
	       (cond ((and negx negy) (helper/ (cdr x) (cdr y) '(1)))
		     (negx (cons '- (helper/ (cdr x) y '(1))))
		     (negy (cons '- (helper/ x (cdr y) '(1))))
		     ('#t (helper/ x y '(1)))))
	     (> '(0) x) (> '(0) y))))

